set.seed(1)

require(plotly)
Loading required package: plotly
Loading required package: ggplot2

Attaching package: ‘plotly’

The following object is masked from ‘package:ggplot2’:

    last_plot

The following object is masked from ‘package:stats’:

    filter

The following object is masked from ‘package:graphics’:

    layout
n = 21
x = rnorm(n,0,3)
v = round(runif(n))
y = 1*v + 1*x + rnorm(n,0,1)

variant <- (y-predict(lm(y~v),newdata=data.frame(v=0)))[v == 1]
control <- (y-predict(lm(y~v),newdata=data.frame(v=0)))[v == 0]
variant_d <- density(variant)
control_d <- density(control)

variant2 <- (y-predict(lm(y~v+x),newdata=data.frame(x=x,v=0)))[v == 1]
control2 <- (y-predict(lm(y~v+x),newdata=data.frame(x=x,v=0)))[v == 0]
variant2_d <- density(variant2)
# variant2_d$y <- variant2_d$y/sum(variant2_d$y)
control2_d <- density(control2)
# control2_d$y <- control2_d$y/sum(control2_d$y)

p1 <- plotly::plot_ly(type = 'scatter', mode= 'markers') %>%
  add_trace(y = x[v==0],x=y[v==0],color='#00263D',showlegend = F) %>%
  add_trace(y = x[v==0],x = predict(lm(y~v),newdata=data.frame(v=rep(0,length(x[v==0])))),
            name='Control',color='#00263D',mode='line',
            error_x = list(
              type='data',symmetric=FALSE,thickness=0.7,
              array=y[v==0]-predict(lm(y~v),newdata=data.frame(v=0))
              )
            ) %>%
  add_trace(y = x[v==1],x=y[v==1],color='#00253C',showlegend = F) %>%
  add_trace(y = x[v==1], x = predict(lm(y~v),newdata=data.frame(v=rep(1,length(x[v==1])))),
            name='Variant',color='#00253C',mode='line',
            error_x = list(
              type='data',symmetric=FALSE,thickness=0.7,
              array=y[v==1]-predict(lm(y~v),newdata=data.frame(v=1))
            )
  ) %>% layout(yaxis= list(title='Relevant covariate',showticklabels = FALSE))

p2 <- plotly::plot_ly(type = 'scatter', mode= 'markers') %>%
  add_trace(y = x[v==0],x=y[v==0],color='#00263D',showlegend = F) %>%
  add_trace(y = x[v==0],x = predict(lm(y~v+x),newdata=data.frame(v=0,x=x[v==0])),
            name='Control',color='#00263D',mode='line',showlegend = F,
            error_x = list(
              type='data',symmetric=FALSE,thickness=0.7,
              array=y[v==0]-predict(lm(y~v+x),newdata=data.frame(v=0,x=x[v==0]))
            )
  ) %>%
  add_trace(y = x[v==1],x=y[v==1],color='#00253C',showlegend = F) %>%
  add_trace(y = x[v==1], x = predict(lm(y~v+x),newdata=data.frame(v=1,x=x[v==1])),
            name='Variant',color='#00253C',mode='line',showlegend = F,
            error_x = list(
              type='data',symmetric=FALSE,thickness=0.7,
              array=y[v==1]-predict(lm(y~v+x),newdata=data.frame(v=1,x=x[v==1]))
              )
  ) %>%
  layout(yaxis = list(showticklabels = FALSE))
  
p3 <- plotly::plot_ly(type = 'scatter', mode= 'lines') %>%
  add_trace(x = y[v==0],type='histogram',histnorm = "probability",color='#00263D',showlegend = F) %>%
  add_trace(x = y[v==1],type='histogram',histnorm = "probability",color='#00253C',showlegend = F) %>%
  add_trace(x = control_d$x, y=control_d$y, fill = 'tozeroy',name='Control',color='#00263D',showlegend = F, yaxis = "y2") %>%
  add_trace(x = variant_d$x, y=variant_d$y, fill = 'tozeroy',name='Variant',color='#00253C',showlegend = F, yaxis = "y2") %>%
  layout(yaxis=list(title='Histogram <br> of samples',showticklabels = FALSE), yaxis2 = list(overlaying = "y3",
  side = "right",showticklabels=FALSE))
  
p4 <- plotly::plot_ly(type = 'scatter', mode= 'lines') %>%
  add_trace(x = control2,type='histogram',histnorm = "probability",color='#00263D',showlegend = F) %>%
  add_trace(x = variant2,type='histogram',histnorm = "probability",color='#00253C',showlegend = F) %>%
  add_trace(x = control2_d$x, y=control2_d$y,fill = 'tozeroy',name='Control',color='#00263D',showlegend = F, yaxis = "y2") %>%
  add_trace(x = variant2_d$x, y=variant2_d$y,fill = 'tozeroy',name='Variant',color='#00253C',showlegend = F, yaxis = "y2") %>%
  layout(yaxis = list(showticklabels = FALSE), yaxis2 = list(overlaying = "y5",side = "right",showticklabels=FALSE))


p5 <-  plotly::plot_ly(type = 'scatter', mode= 'lines') %>%
  add_trace(x = seq(min(y[v==0]),max(y[v==0]),0.01), y = dnorm(x = seq(min(y[v==0]),max(y[v==0]),0.01), mean = mean(y[v==0]), sd = sd(control)/sqrt(sum(v==0))), fill = 'tozeroy',name='Control',color='#00263D',showlegend = F) %>%
  add_trace(x = seq(min(y[v==0]),max(y[v==0]),0.01), y = dnorm(x = seq(min(y[v==0]),max(y[v==0]),0.01), mean = mean(y[v==1]), sd = sd(variant)/sqrt(sum(v==1))), fill = 'tozeroy',name='Control',color='#00253C',showlegend = F) %>%
  layout(xaxis = list(title = 'Typical A/B test: no variance reduction'), yaxis = list(title = 'Est. sampling <br> dist. of means',showtickLabels=FALSE))

p6 <-  plotly::plot_ly(type = 'scatter', mode= 'lines') %>%
  add_trace(x = seq(min(y[v==0]),max(y[v==0]),0.01), y = dnorm(x = seq(min(y[v==0]),max(y[v==0]),0.01), mean = mean(y[v==0]), sd = sd(control2)/sqrt(sum(v==0))), fill = 'tozeroy',name='Control',color='#00263D',showlegend = F) %>%
  add_trace(x = seq(min(y[v==0]),max(y[v==0]),0.01), y = dnorm(x = seq(min(y[v==0]),max(y[v==0]),0.01), mean = mean(y[v==1]), sd = sd(variant2)/sqrt(sum(v==1))), fill = 'tozeroy',name='Control',color='#00253C',showlegend = F) %>%
  layout(xaxis = list(title = 'Linear Variance reduction'), yaxis = list(showticklabels = FALSE))

subplot(p1,p2,p3,p4,p5,p6,nrows=3, shareY = F,shareX = T, titleX = T, titleY = T, margin = c(0.1,0,0.05,0))
NA
LS0tCnRpdGxlOiAiTUxSQVRFIgpvdXRwdXQ6CiAgaHRtbF9ub3RlYm9vazoKICAgIGNvZGVfZm9sZGluZzogaGlkZQotLS0KCmBgYHtyIG1lc3NhZ2U9RkFMU0Usd2FybmluZz1GQUxTRSwgZmlnLndpZHRoID0gMTB9CnNldC5zZWVkKDEpCgpyZXF1aXJlKHBsb3RseSkKCm4gPSAyMQp4ID0gcm5vcm0obiwwLDMpCnYgPSByb3VuZChydW5pZihuKSkKeSA9IDEqdiArIDEqeCArIHJub3JtKG4sMCwxKQoKdmFyaWFudCA8LSAoeS1wcmVkaWN0KGxtKHl+diksbmV3ZGF0YT1kYXRhLmZyYW1lKHY9MCkpKVt2ID09IDFdCmNvbnRyb2wgPC0gKHktcHJlZGljdChsbSh5fnYpLG5ld2RhdGE9ZGF0YS5mcmFtZSh2PTApKSlbdiA9PSAwXQp2YXJpYW50X2QgPC0gZGVuc2l0eSh2YXJpYW50KQpjb250cm9sX2QgPC0gZGVuc2l0eShjb250cm9sKQoKdmFyaWFudDIgPC0gKHktcHJlZGljdChsbSh5fnYreCksbmV3ZGF0YT1kYXRhLmZyYW1lKHg9eCx2PTApKSlbdiA9PSAxXQpjb250cm9sMiA8LSAoeS1wcmVkaWN0KGxtKHl+dit4KSxuZXdkYXRhPWRhdGEuZnJhbWUoeD14LHY9MCkpKVt2ID09IDBdCnZhcmlhbnQyX2QgPC0gZGVuc2l0eSh2YXJpYW50MikKIyB2YXJpYW50Ml9kJHkgPC0gdmFyaWFudDJfZCR5L3N1bSh2YXJpYW50Ml9kJHkpCmNvbnRyb2wyX2QgPC0gZGVuc2l0eShjb250cm9sMikKIyBjb250cm9sMl9kJHkgPC0gY29udHJvbDJfZCR5L3N1bShjb250cm9sMl9kJHkpCgpwMSA8LSBwbG90bHk6OnBsb3RfbHkodHlwZSA9ICdzY2F0dGVyJywgbW9kZT0gJ21hcmtlcnMnKSAlPiUKICBhZGRfdHJhY2UoeSA9IHhbdj09MF0seD15W3Y9PTBdLGNvbG9yPScjMDAyNjNEJyxzaG93bGVnZW5kID0gRikgJT4lCiAgYWRkX3RyYWNlKHkgPSB4W3Y9PTBdLHggPSBwcmVkaWN0KGxtKHl+diksbmV3ZGF0YT1kYXRhLmZyYW1lKHY9cmVwKDAsbGVuZ3RoKHhbdj09MF0pKSkpLAogICAgICAgICAgICBuYW1lPSdDb250cm9sJyxjb2xvcj0nIzAwMjYzRCcsbW9kZT0nbGluZScsCiAgICAgICAgICAgIGVycm9yX3ggPSBsaXN0KAogICAgICAgICAgICAgIHR5cGU9J2RhdGEnLHN5bW1ldHJpYz1GQUxTRSx0aGlja25lc3M9MC43LAogICAgICAgICAgICAgIGFycmF5PXlbdj09MF0tcHJlZGljdChsbSh5fnYpLG5ld2RhdGE9ZGF0YS5mcmFtZSh2PTApKQogICAgICAgICAgICAgICkKICAgICAgICAgICAgKSAlPiUKICBhZGRfdHJhY2UoeSA9IHhbdj09MV0seD15W3Y9PTFdLGNvbG9yPScjMDAyNTNDJyxzaG93bGVnZW5kID0gRikgJT4lCiAgYWRkX3RyYWNlKHkgPSB4W3Y9PTFdLCB4ID0gcHJlZGljdChsbSh5fnYpLG5ld2RhdGE9ZGF0YS5mcmFtZSh2PXJlcCgxLGxlbmd0aCh4W3Y9PTFdKSkpKSwKICAgICAgICAgICAgbmFtZT0nVmFyaWFudCcsY29sb3I9JyMwMDI1M0MnLG1vZGU9J2xpbmUnLAogICAgICAgICAgICBlcnJvcl94ID0gbGlzdCgKICAgICAgICAgICAgICB0eXBlPSdkYXRhJyxzeW1tZXRyaWM9RkFMU0UsdGhpY2tuZXNzPTAuNywKICAgICAgICAgICAgICBhcnJheT15W3Y9PTFdLXByZWRpY3QobG0oeX52KSxuZXdkYXRhPWRhdGEuZnJhbWUodj0xKSkKICAgICAgICAgICAgKQogICkgJT4lIGxheW91dCh5YXhpcz0gbGlzdCh0aXRsZT0nUmVsZXZhbnQgY292YXJpYXRlJyxzaG93dGlja2xhYmVscyA9IEZBTFNFKSkKCnAyIDwtIHBsb3RseTo6cGxvdF9seSh0eXBlID0gJ3NjYXR0ZXInLCBtb2RlPSAnbWFya2VycycpICU+JQogIGFkZF90cmFjZSh5ID0geFt2PT0wXSx4PXlbdj09MF0sY29sb3I9JyMwMDI2M0QnLHNob3dsZWdlbmQgPSBGKSAlPiUKICBhZGRfdHJhY2UoeSA9IHhbdj09MF0seCA9IHByZWRpY3QobG0oeX52K3gpLG5ld2RhdGE9ZGF0YS5mcmFtZSh2PTAseD14W3Y9PTBdKSksCiAgICAgICAgICAgIG5hbWU9J0NvbnRyb2wnLGNvbG9yPScjMDAyNjNEJyxtb2RlPSdsaW5lJyxzaG93bGVnZW5kID0gRiwKICAgICAgICAgICAgZXJyb3JfeCA9IGxpc3QoCiAgICAgICAgICAgICAgdHlwZT0nZGF0YScsc3ltbWV0cmljPUZBTFNFLHRoaWNrbmVzcz0wLjcsCiAgICAgICAgICAgICAgYXJyYXk9eVt2PT0wXS1wcmVkaWN0KGxtKHl+dit4KSxuZXdkYXRhPWRhdGEuZnJhbWUodj0wLHg9eFt2PT0wXSkpCiAgICAgICAgICAgICkKICApICU+JQogIGFkZF90cmFjZSh5ID0geFt2PT0xXSx4PXlbdj09MV0sY29sb3I9JyMwMDI1M0MnLHNob3dsZWdlbmQgPSBGKSAlPiUKICBhZGRfdHJhY2UoeSA9IHhbdj09MV0sIHggPSBwcmVkaWN0KGxtKHl+dit4KSxuZXdkYXRhPWRhdGEuZnJhbWUodj0xLHg9eFt2PT0xXSkpLAogICAgICAgICAgICBuYW1lPSdWYXJpYW50Jyxjb2xvcj0nIzAwMjUzQycsbW9kZT0nbGluZScsc2hvd2xlZ2VuZCA9IEYsCiAgICAgICAgICAgIGVycm9yX3ggPSBsaXN0KAogICAgICAgICAgICAgIHR5cGU9J2RhdGEnLHN5bW1ldHJpYz1GQUxTRSx0aGlja25lc3M9MC43LAogICAgICAgICAgICAgIGFycmF5PXlbdj09MV0tcHJlZGljdChsbSh5fnYreCksbmV3ZGF0YT1kYXRhLmZyYW1lKHY9MSx4PXhbdj09MV0pKQogICAgICAgICAgICAgICkKICApICU+JQogIGxheW91dCh5YXhpcyA9IGxpc3Qoc2hvd3RpY2tsYWJlbHMgPSBGQUxTRSkpCiAgCnAzIDwtIHBsb3RseTo6cGxvdF9seSh0eXBlID0gJ3NjYXR0ZXInLCBtb2RlPSAnbGluZXMnKSAlPiUKICBhZGRfdHJhY2UoeCA9IHlbdj09MF0sdHlwZT0naGlzdG9ncmFtJyxoaXN0bm9ybSA9ICJwcm9iYWJpbGl0eSIsY29sb3I9JyMwMDI2M0QnLHNob3dsZWdlbmQgPSBGKSAlPiUKICBhZGRfdHJhY2UoeCA9IHlbdj09MV0sdHlwZT0naGlzdG9ncmFtJyxoaXN0bm9ybSA9ICJwcm9iYWJpbGl0eSIsY29sb3I9JyMwMDI1M0MnLHNob3dsZWdlbmQgPSBGKSAlPiUKICBhZGRfdHJhY2UoeCA9IGNvbnRyb2xfZCR4LCB5PWNvbnRyb2xfZCR5LCBmaWxsID0gJ3RvemVyb3knLG5hbWU9J0NvbnRyb2wnLGNvbG9yPScjMDAyNjNEJyxzaG93bGVnZW5kID0gRiwgeWF4aXMgPSAieTIiKSAlPiUKICBhZGRfdHJhY2UoeCA9IHZhcmlhbnRfZCR4LCB5PXZhcmlhbnRfZCR5LCBmaWxsID0gJ3RvemVyb3knLG5hbWU9J1ZhcmlhbnQnLGNvbG9yPScjMDAyNTNDJyxzaG93bGVnZW5kID0gRiwgeWF4aXMgPSAieTIiKSAlPiUKICBsYXlvdXQoeWF4aXM9bGlzdCh0aXRsZT0nSGlzdG9ncmFtIDxicj4gb2Ygc2FtcGxlcycsc2hvd3RpY2tsYWJlbHMgPSBGQUxTRSksIHlheGlzMiA9IGxpc3Qob3ZlcmxheWluZyA9ICJ5MyIsCiAgc2lkZSA9ICJyaWdodCIsc2hvd3RpY2tsYWJlbHM9RkFMU0UpKQogIApwNCA8LSBwbG90bHk6OnBsb3RfbHkodHlwZSA9ICdzY2F0dGVyJywgbW9kZT0gJ2xpbmVzJykgJT4lCiAgYWRkX3RyYWNlKHggPSBjb250cm9sMix0eXBlPSdoaXN0b2dyYW0nLGhpc3Rub3JtID0gInByb2JhYmlsaXR5Iixjb2xvcj0nIzAwMjYzRCcsc2hvd2xlZ2VuZCA9IEYpICU+JQogIGFkZF90cmFjZSh4ID0gdmFyaWFudDIsdHlwZT0naGlzdG9ncmFtJyxoaXN0bm9ybSA9ICJwcm9iYWJpbGl0eSIsY29sb3I9JyMwMDI1M0MnLHNob3dsZWdlbmQgPSBGKSAlPiUKICBhZGRfdHJhY2UoeCA9IGNvbnRyb2wyX2QkeCwgeT1jb250cm9sMl9kJHksZmlsbCA9ICd0b3plcm95JyxuYW1lPSdDb250cm9sJyxjb2xvcj0nIzAwMjYzRCcsc2hvd2xlZ2VuZCA9IEYsIHlheGlzID0gInkyIikgJT4lCiAgYWRkX3RyYWNlKHggPSB2YXJpYW50Ml9kJHgsIHk9dmFyaWFudDJfZCR5LGZpbGwgPSAndG96ZXJveScsbmFtZT0nVmFyaWFudCcsY29sb3I9JyMwMDI1M0MnLHNob3dsZWdlbmQgPSBGLCB5YXhpcyA9ICJ5MiIpICU+JQogIGxheW91dCh5YXhpcyA9IGxpc3Qoc2hvd3RpY2tsYWJlbHMgPSBGQUxTRSksIHlheGlzMiA9IGxpc3Qob3ZlcmxheWluZyA9ICJ5NSIsc2lkZSA9ICJyaWdodCIsc2hvd3RpY2tsYWJlbHM9RkFMU0UpKQoKCnA1IDwtICBwbG90bHk6OnBsb3RfbHkodHlwZSA9ICdzY2F0dGVyJywgbW9kZT0gJ2xpbmVzJykgJT4lCiAgYWRkX3RyYWNlKHggPSBzZXEobWluKHlbdj09MF0pLG1heCh5W3Y9PTBdKSwwLjAxKSwgeSA9IGRub3JtKHggPSBzZXEobWluKHlbdj09MF0pLG1heCh5W3Y9PTBdKSwwLjAxKSwgbWVhbiA9IG1lYW4oeVt2PT0wXSksIHNkID0gc2QoY29udHJvbCkvc3FydChzdW0odj09MCkpKSwgZmlsbCA9ICd0b3plcm95JyxuYW1lPSdDb250cm9sJyxjb2xvcj0nIzAwMjYzRCcsc2hvd2xlZ2VuZCA9IEYpICU+JQogIGFkZF90cmFjZSh4ID0gc2VxKG1pbih5W3Y9PTBdKSxtYXgoeVt2PT0wXSksMC4wMSksIHkgPSBkbm9ybSh4ID0gc2VxKG1pbih5W3Y9PTBdKSxtYXgoeVt2PT0wXSksMC4wMSksIG1lYW4gPSBtZWFuKHlbdj09MV0pLCBzZCA9IHNkKHZhcmlhbnQpL3NxcnQoc3VtKHY9PTEpKSksIGZpbGwgPSAndG96ZXJveScsbmFtZT0nQ29udHJvbCcsY29sb3I9JyMwMDI1M0MnLHNob3dsZWdlbmQgPSBGKSAlPiUKICBsYXlvdXQoeGF4aXMgPSBsaXN0KHRpdGxlID0gJ1R5cGljYWwgQS9CIHRlc3Q6IG5vIHZhcmlhbmNlIHJlZHVjdGlvbicpLCB5YXhpcyA9IGxpc3QodGl0bGUgPSAnRXN0LiBzYW1wbGluZyA8YnI+IGRpc3QuIG9mIG1lYW5zJyxzaG93dGlja0xhYmVscz1GQUxTRSkpCgpwNiA8LSAgcGxvdGx5OjpwbG90X2x5KHR5cGUgPSAnc2NhdHRlcicsIG1vZGU9ICdsaW5lcycpICU+JQogIGFkZF90cmFjZSh4ID0gc2VxKG1pbih5W3Y9PTBdKSxtYXgoeVt2PT0wXSksMC4wMSksIHkgPSBkbm9ybSh4ID0gc2VxKG1pbih5W3Y9PTBdKSxtYXgoeVt2PT0wXSksMC4wMSksIG1lYW4gPSBtZWFuKHlbdj09MF0pLCBzZCA9IHNkKGNvbnRyb2wyKS9zcXJ0KHN1bSh2PT0wKSkpLCBmaWxsID0gJ3RvemVyb3knLG5hbWU9J0NvbnRyb2wnLGNvbG9yPScjMDAyNjNEJyxzaG93bGVnZW5kID0gRikgJT4lCiAgYWRkX3RyYWNlKHggPSBzZXEobWluKHlbdj09MF0pLG1heCh5W3Y9PTBdKSwwLjAxKSwgeSA9IGRub3JtKHggPSBzZXEobWluKHlbdj09MF0pLG1heCh5W3Y9PTBdKSwwLjAxKSwgbWVhbiA9IG1lYW4oeVt2PT0xXSksIHNkID0gc2QodmFyaWFudDIpL3NxcnQoc3VtKHY9PTEpKSksIGZpbGwgPSAndG96ZXJveScsbmFtZT0nQ29udHJvbCcsY29sb3I9JyMwMDI1M0MnLHNob3dsZWdlbmQgPSBGKSAlPiUKICBsYXlvdXQoeGF4aXMgPSBsaXN0KHRpdGxlID0gJ0xpbmVhciBWYXJpYW5jZSByZWR1Y3Rpb24nKSwgeWF4aXMgPSBsaXN0KHNob3d0aWNrbGFiZWxzID0gRkFMU0UpKQoKc3VicGxvdChwMSxwMixwMyxwNCxwNSxwNixucm93cz0zLCBzaGFyZVkgPSBGLHNoYXJlWCA9IFQsIHRpdGxlWCA9IFQsIHRpdGxlWSA9IFQsIG1hcmdpbiA9IGMoMC4xLDAsMC4wNSwwKSkKCmBgYAoK